home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / IMPULS.M < prev    next >
Encoding:
Text File  |  1990-02-17  |  10.2 KB  |  354 lines
  1. MODULE Impuls;
  2.  
  3. (*
  4.   Beispielprogramm für Soft~wave Modula-2
  5.   von Rolf Hänisch, Katzbachstr. 6, 1000 Berlin 61
  6.   
  7.   Anpassung auf Megamax M-2 am 28.5.88 & 18.2.90 von Thomas Tempelmann
  8.   - Prozeduren vertauscht wg. 1-Pass
  9.   - In 'BewegeKugeln' Const Expr. durch CONSTs ersetzt.
  10.   - Reg-Vars eingesetzt
  11. *)
  12.  
  13. FROM SYSTEM IMPORT ADDRESS, ADR, BITNUM;
  14. IMPORT BIOS, XBIOS, LineA;
  15. FROM GrafBase IMPORT Pnt;
  16.  
  17. CONST
  18.      MAXKugeln = 8;
  19.  
  20.      DELTA = 0;
  21.      MAXX = 640-16-DELTA;
  22.      MAXY = 400-16-DELTA;
  23.      MINX = DELTA;
  24.      MINY = DELTA;
  25.      FAKTOR = 50;
  26.      MINX_FAKTOR = MINX * FAKTOR;
  27.      MINY_FAKTOR = MINY * FAKTOR;
  28.      MAXX_FAKTOR = MAXX * FAKTOR;
  29.      MAXY_FAKTOR = MAXY * FAKTOR;
  30.      MAXV = 8;
  31.      MAXV_FAKTOR = MAXV * FAKTOR;
  32.      WZEIT = 00;
  33.      g = 0;
  34.  
  35. TYPE
  36.         SHORTINT = INTEGER;
  37.         Integer = LONGINT;
  38.         BitSet = SET OF BITNUM [0..15];
  39.         
  40.      Kugel = RECORD
  41.           xx, yy,
  42.           px, py,
  43.           vx, vy : Integer;
  44.           Sprite : ADDRESS;
  45.           buffer : ARRAY [0..99] OF CHAR;
  46.           END;
  47.  
  48.      Kugeln = [1..MAXKugeln];
  49.      KList = ARRAY Kugeln OF INTEGER;
  50.  
  51. VAR
  52.  
  53.      Abstand : ARRAY Kugeln OF ARRAY Kugeln OF Integer;
  54.  
  55.      KugelListe : ARRAY Kugeln OF Kugel;
  56.  
  57.      Ordnung, XOrdnung : KList;
  58.  
  59.      sprite: RECORD
  60.                x: SHORTINT;
  61.                y: SHORTINT;
  62.                form: SHORTINT;
  63.                back: SHORTINT;
  64.                forg: SHORTINT;
  65.                image: ARRAY [0..31] OF BitSet;
  66.              END;
  67.  
  68. PROCEDURE InitSprite;
  69. BEGIN
  70.      sprite.x := 0;
  71.      sprite.y := 0;
  72.      sprite.form := -1;
  73.      sprite.back := 0;
  74.      sprite.forg := 1;
  75.      
  76.      sprite.image [0]:= BitSet {6..10};
  77.      sprite.image [2]:= BitSet {4..12};
  78.      sprite.image [4]:= BitSet {3..13};
  79.      sprite.image [6]:= BitSet {2..14};
  80.      sprite.image [8]:= BitSet {2..14};
  81.      sprite.image [10]:= BitSet {1..15};
  82.      sprite.image [12]:= BitSet {1..15};
  83.      sprite.image [14]:= BitSet {1..15};
  84.      sprite.image [16]:= BitSet {1..15};
  85.      sprite.image [18]:= BitSet {1..15};
  86.      sprite.image [20]:= BitSet {2..14};
  87.      sprite.image [22]:= BitSet {2..14};
  88.      sprite.image [24]:= BitSet {3..13};
  89.      sprite.image [26]:= BitSet {4..12};
  90.      sprite.image [28]:= BitSet {6..10};
  91.      sprite.image [30]:= BitSet {};
  92.  
  93.      sprite.image [1]:= BitSet {6..10};
  94.      sprite.image [3]:= BitSet {4..7, 9..12};
  95.      sprite.image [5]:= BitSet {3..6, 11..13};
  96.      sprite.image [7]:= BitSet {2..7, 12..14};
  97.      sprite.image [9]:= BitSet {2..9, 13..14};
  98.      sprite.image [11]:= BitSet {1..10, 13..15};
  99.      sprite.image [13]:= BitSet {1..11, 14..15};
  100.      sprite.image [15]:= BitSet {1..11, 13..15};
  101.      sprite.image [17]:= BitSet {1..15};
  102.      sprite.image [19]:= BitSet {1..15};
  103.      sprite.image [21]:= BitSet {2..14};
  104.      sprite.image [23]:= BitSet {2..14};
  105.      sprite.image [25]:= BitSet {3..13};
  106.      sprite.image [27]:= BitSet {4..12};
  107.      sprite.image [29]:= BitSet {6..10};
  108.      sprite.image [31]:= BitSet {};
  109.      
  110. END InitSprite;
  111.  
  112. PROCEDURE Zufall (min, max: Integer): Integer;
  113. BEGIN
  114.      RETURN LONGINT(XBIOS.Random ()) MOD (max-min) + min;
  115. END Zufall;
  116.  
  117. PROCEDURE InitKugeln;
  118. VAR
  119.      i: SHORTINT;
  120. BEGIN
  121.      FOR i := 1 TO MAXKugeln DO
  122.           WITH KugelListe [i] DO
  123.                Sprite := ADR (sprite);
  124.                px := Zufall (MINX_FAKTOR, MAXX_FAKTOR);
  125.                py := Zufall (MINY_FAKTOR, MAXY_FAKTOR);
  126.                xx := px DIV FAKTOR;
  127.                yy := py DIV FAKTOR;
  128.                vx := Zufall (-MAXV_FAKTOR, MAXV_FAKTOR);
  129.                vy := Zufall (-MAXV_FAKTOR, MAXV_FAKTOR);
  130.           END (*WITH*);
  131.      END (*FOR*);
  132. END InitKugeln;
  133.  
  134. PROCEDURE Ordne (VAR Ordnung: KList);
  135. VAR
  136.      (*$Reg*)i, (*$Reg*)j, (*$Reg*)k, (*$Reg*)t: SHORTINT;
  137. BEGIN
  138.      Ordnung [1] := 1;
  139.      FOR i := 2 TO MAXKugeln DO
  140.           k := i;
  141.           FOR j := 1 TO i - 1 DO
  142.                IF KugelListe [Ordnung [j]].yy > KugelListe [k].yy
  143.                THEN t := Ordnung [j];
  144.                     Ordnung [j] := k;
  145.                     k := t;
  146.                     END;
  147.                END;
  148.           Ordnung [i] := k;
  149.           END;
  150. END Ordne;
  151.  
  152. VAR
  153.      pink: ARRAY [0..5] OF CHAR;
  154.      ip: ARRAY [0..19] OF CHAR;
  155.  
  156. PROCEDURE Pink;
  157. BEGIN (* Pink *)
  158.      XBIOS.DoSound (ADR (pink));
  159. END Pink;
  160.  
  161. PROCEDURE EndPink;
  162. BEGIN (* EmdPink *)
  163.      ip [0] := 07C;
  164.      ip [1] := 77C;
  165.      ip [2] := 377C;
  166.      ip [3] := 00C;
  167.      XBIOS.DoSound (ADR (ip));
  168. END EndPink;
  169.  
  170. PROCEDURE MaleKugeln;
  171. VAR
  172.      i: SHORTINT;
  173.      b: LineA.PtrSpriteBuffer;
  174.      
  175. BEGIN
  176.      FOR i := 1 TO MAXKugeln DO
  177.           WITH KugelListe [Ordnung [i]] DO
  178.                IF (xx < 640) AND (yy < 400) THEN
  179.                    b.onePlane:= ADR (buffer);
  180.                    LineA.DrawSprite (Pnt(SHORT(xx), SHORT(yy)), Sprite, b);
  181.                END;
  182.           END (*WITH*);
  183.      END (*FOR*);
  184. END MaleKugeln;
  185.  
  186. PROCEDURE LoescheKugeln;
  187. VAR
  188.      i: SHORTINT;
  189.      b: LineA.PtrSpriteBuffer;
  190.      
  191. BEGIN
  192.      FOR i := MAXKugeln TO 1 BY - 1 DO
  193.           WITH KugelListe [Ordnung [i]] DO
  194.                b.onePlane:= ADR (buffer);
  195.                LineA.UndrawSprite (b);
  196.                END (*WITH*);
  197.           END (*FOR*);
  198. END LoescheKugeln;
  199.  
  200. PROCEDURE BewegeKugeln;
  201.  
  202. VAR  (*$Reg*)i, (*$Reg*)j : SHORTINT;
  203.      a, b,
  204.      (*$Reg*)x2, (*$Reg*)y2, d,
  205.      VX0, VX1,
  206.      VY0, VY1,
  207.      vjx3, vjx4,
  208.      vjy3, vjy4,
  209.      vix3, vix4,
  210.      viy3, viy4: Integer;
  211.      Kollision : BOOLEAN;
  212.      Fehler: BOOLEAN;
  213.  
  214. BEGIN
  215.      FOR i := 1 TO MAXKugeln DO
  216.           WITH KugelListe [i] DO
  217.  
  218.                px:= px + vx;
  219.                IF px < MINX_FAKTOR THEN vx := -vx; px:= px + vx; END;
  220.                IF px > MAXX_FAKTOR THEN vx := -vx; px:= px + vx; END;
  221.                xx := px DIV FAKTOR;
  222.  
  223.                py:= py + vy;
  224.                IF py < MINY_FAKTOR THEN vy := -vy; py:= py + vy; END;
  225.                IF py > MAXY_FAKTOR THEN vy := -vy; py:= py + vy; END;
  226.                yy := py DIV FAKTOR;
  227.  
  228.                END (*WITH*);
  229.           END (*FOR*);
  230.  
  231.      Kollision := FALSE;
  232.      Fehler := FALSE;
  233.      FOR i := 1 TO MAXKugeln - 1 DO
  234.           FOR j := i + 1 TO MAXKugeln DO
  235.                x2 := KugelListe [j].py - KugelListe [i].py;
  236.                y2 := - (KugelListe [j].px - KugelListe [i].px);
  237.                d := x2 * x2 + y2 * y2;
  238.                IF (d < 15 * 15 * FAKTOR * FAKTOR)
  239.                AND (d < Abstand [i][j])
  240.                THEN (* Kollision *)
  241.                     Kollision := TRUE;
  242.                     (* v3 = Eigengeschwindigkeit *)
  243.                     (* v4 = Impulsgeschwindigkeit *)
  244.                     WITH KugelListe [j] DO
  245.                          a := vy * x2 - vx * y2;
  246.                          vjy4 := x2 * a DIV d;
  247.                          vjx4 := y2 * (-a) DIV d;
  248.                          (**)
  249.                          b := vy * y2 + vx * x2;
  250.                          vjy3 := y2 * b DIV d;
  251.                          vjx3 := x2 * b DIV d;
  252.                          (*
  253.                          vjy3 := vy - vjy4;
  254.                          vjx3 := vx - vjx4;
  255.                          *)
  256.                     END (*WITH*);
  257.                     WITH KugelListe [i] DO
  258.                          a := vy * x2 - vx * y2;
  259.                          viy4 := x2 * a DIV d;
  260.                          vix4 := y2 * (-a) DIV d;
  261.                          (**)
  262.                          b := vy * y2 + vx * x2;
  263.                          viy3 := y2 * b DIV d;
  264.                          vix3 := x2 * b DIV d;
  265.                          (*
  266.                          viy3 := vy - viy4;
  267.                          vix3 := vx - vix4;
  268.                          *)
  269.                     END (*WITH*);
  270.                     KugelListe [j].vx := vjx3 + vix4;
  271.                     KugelListe [j].vy := vjy3 + viy4;
  272.                     KugelListe [i].vx := vix3 + vjx4;
  273.                     KugelListe [i].vy := viy3 + vjy4;
  274.                END;
  275.                Abstand [i][j] := d;
  276.           END (*FOR*);
  277.      END (*FOR*);
  278.      IF Kollision THEN Pink END;
  279. END BewegeKugeln;
  280.  
  281. PROCEDURE InitPink;
  282. BEGIN
  283.      (* Register 0/1 = 41 (Frequenz) *)
  284.      ip [0] := 00C;
  285.      ip [1] := 51C;
  286.      ip [2] := 01C;
  287.      ip [3] := 00C;
  288.      (* Register 8 = Steuerung durch Hüllkurve *)
  289.      ip [4] := 10C;
  290.      ip [5] := 20C;
  291.      (* Register 13 = Art der Huelkurve *)
  292.      ip [6] := 15C;
  293.      ip [7] := 00C;
  294.      (* Register 11/12 = 3276 (Laenge der Hüllkurve) *)
  295.      ip [8] := 13C;
  296.      ip [9] := 314C;
  297.      ip [10] := 14C;
  298.      ip [11] := 14C;
  299.      (* Register 7 = A Kanal einschalten *)
  300.      ip [12] := 07C;
  301.      ip [13] := 76C;
  302.      (* Ende *)
  303.      ip [14] := 377C;
  304.      ip [15] := 0C;
  305.      XBIOS.DoSound (ADR (ip));
  306.      pink [0] := 15C;
  307.      pink [1] := 11C;
  308.      pink [2] := 377C;
  309.      pink [3] := 14C;
  310.      pink [4] := 377C;
  311.      pink [5] := 00C;
  312. END InitPink;
  313.  
  314. PROCEDURE Impuls;
  315. VAR
  316.      lc: LONGCARD;
  317.      Zaehler: SHORTINT;
  318.  
  319.      PROCEDURE Warten;
  320.      VAR
  321.           i : SHORTINT;
  322.      BEGIN
  323.           XBIOS.VSync;
  324.           FOR i := 0 TO WZEIT DO END;
  325.      END Warten;
  326.  
  327. BEGIN
  328.      InitSprite;
  329.      InitKugeln;
  330.      Ordne (Ordnung);
  331.      MaleKugeln;
  332.      REPEAT
  333.           Warten;
  334.           BewegeKugeln;
  335.           Ordne (XOrdnung);
  336.           LoescheKugeln;
  337.           Ordnung := XOrdnung;
  338.           MaleKugeln;
  339.      UNTIL BIOS.BConStat (BIOS.CON);
  340.      lc:= BIOS.BConIn (BIOS.CON);
  341.      LoescheKugeln;
  342. END Impuls;
  343.  
  344.  
  345. BEGIN
  346.      (*LineA.HideMouse;*)
  347.      InitPink;
  348.      Impuls;
  349.      EndPink;
  350.      (*LineA.ShowMouse(TRUE);*)
  351. END Impuls.
  352. ə
  353. (* $FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$0000106F$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4$FFEA4CE4ü$00001E23T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$0000030E$00001B4B$00001D74$FFEA33DA$FFEA33DA$00001B99$00001B15$00001BFA$00001C87$00001E23$00001E9A$00001607$00001514$00000137$000000A9$FFEA33DA¼ÇÇ*)
  354.